home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / System / Sample Init / Sample with A4 / Init.p next >
Text File  |  1997-02-01  |  3KB  |  164 lines
  1. unit Init;
  2.  
  3. interface
  4.  
  5. {$MAIN}
  6.     procedure Main;
  7.  
  8. implementation
  9.  
  10.     uses
  11.         Types, Files, Events, OSUtils, Resources, Memory, Processes, GestaltEqu, Traps, SegLoad, 
  12.         PascalA4;
  13.  
  14.     const
  15.         bad_rn = -32768;
  16.  
  17.     const
  18.         CurAppNameAddr = $910;
  19.         FinderNameAddr = $2E0;
  20.  
  21.     const
  22.         SharedDataGestalt = 'AsiX';
  23.         SDF_Fired_bit = 1;
  24.         SDF_Finished_bit = 3;
  25.         SDF_StartFinder_bit = 4;
  26.  
  27.     type
  28.         SharedData = record
  29.                 assimilator_datafork_rn: integer;
  30.                 flags: longInt;
  31.             end;
  32.         SharedDataPtr = ^SharedData;
  33.         SharedDataHandle = ^SharedDataPtr;
  34.         SharedDataPtrPtr = ^SharedDataPtr;
  35.  
  36.     var
  37.         old_patch_addr: ProcPtr;
  38.         shared_data: SharedData;
  39.         
  40.     function RefNumToFSSpec (rn: integer; var fs: FSSpec): OSErr;
  41.         var
  42.             pb: FCBPBRec;
  43.     begin
  44.         pb.ioNamePtr := @fs.name;
  45.         pb.ioVRefNum := 0;
  46.         pb.ioRefNum := rn;
  47.         pb.ioFCBIndx := 0;
  48.         RefNumToFSSpec := PBGetFCBInfoSync(@pb);
  49.         fs.vRefNum := pb.ioFCBVRefNum;
  50.         fs.parID := pb.ioFCBParID;
  51.     end;
  52.  
  53.     function FSpGetCatInfo (var fs: FSSpec; index: integer; var pb: CInfoPBRec): OSErr;
  54.     begin
  55.         pb.ioVRefNum := fs.vRefNum;
  56.         pb.ioDirID := fs.parID;
  57.         pb.ioNamePtr := @fs.name;
  58.         pb.ioFDirIndex := index;
  59.         FSpGetCatInfo := PBGetCatInfoSync(@pb);
  60.     end;
  61.  
  62.     procedure LaunchFSSpec (var fs: FSSpec);
  63.         var
  64.             lpb: LaunchParamBlockRec;
  65.             junk: OSErr;
  66.     begin
  67.         lpb.launchBlockID := extendedBlock;
  68.         lpb.launchEPBLength := extendedBlockLen;
  69.         lpb.launchFileFlags := 0;
  70.         lpb.launchControlFlags := launchNoFileFlags;
  71.         lpb.launchAppSpec := @fs;
  72.         lpb.launchAppParameters := nil;
  73.         junk := LaunchApplication(@lpb);
  74.     end;
  75.  
  76.     procedure MyInitMenus;
  77.         var
  78.             sd: SharedDataPtr;
  79.             gv: longint;
  80.             spec: FSSPec;
  81.     begin
  82.         sd := @shared_data;
  83.         if not BTST( sd^.flags, SDF_Finished_bit ) then begin
  84.             if (StringPtr(CurAppNameAddr)^ = StringPtr(FinderNameAddr)^) then begin
  85.                 if not BTST( sd^.flags, SDF_Fired_bit ) then begin
  86.                     BSET( sd^.flags, SDF_Fired_bit );
  87.                     BSET( sd^.flags, SDF_StartFinder_bit );
  88.                     if (Gestalt(gestaltOSAttr, gv) = noErr) & (BTST(gv, gestaltLaunchFullFileSpec)) then begin
  89.                         if RefNumToFSSpec( sd^.assimilator_datafork_rn, spec ) = noErr then begin
  90.                             LaunchFSSpec( spec );
  91.                             { NOT REACHED }
  92.                         end;
  93.                     end;
  94.                 end;
  95.                 ExitToShell;
  96.             end;
  97.         end;
  98.     end;
  99.  
  100.     function MySetupA4: longint;
  101.     begin
  102.         MySetupA4 := SetUpA4;
  103.     end;
  104.     
  105.     procedure MyPatch; asm;
  106.     begin
  107.         clr.l    -(sp)
  108.         movem.l    d0-d2/a0-a1,-(sp)
  109.         
  110.         clr.l    -(sp)
  111.         jsr    MySetupA4
  112.         
  113.         jsr    MyInitMenus
  114.         
  115.         move.l    old_patch_addr,24(sp)        { d0-d2, a0-a1, A4 }
  116.         
  117.         move.l    (sp)+, a4
  118.  
  119.         movem.l    (sp)+,d0-d2/a0-a1
  120.         rts
  121.     end;
  122.     
  123.     function MyGestalt (selector: OSType; var response: longInt): OSErr;
  124.         var
  125.             a4: longint;
  126.     begin
  127. {$unused(selector)}
  128.         a4 := SetUpA4;
  129.         response := longInt(@shared_data);
  130.         a4 := RestoreA4( a4 );
  131.         MyGestalt := noErr;
  132.     end;
  133.  
  134.     procedure Main;
  135.         var
  136.             sd: SharedDataPtr;
  137.             junk: OSErr;
  138.             fs: FSSpec;
  139.             a4: longint;
  140.     begin
  141.         a4 := SetCurrentA4;
  142.         RememberA4;
  143.         DetachResource(Get1Resource('INIT', 128));
  144.  
  145.         sd := @shared_data;
  146.         sd^.flags := 0;
  147.         sd^.assimilator_datafork_rn := bad_rn;
  148.  
  149.         junk := NewGestalt(SharedDataGestalt, @MyGestalt);
  150.         
  151.         if RefNumToFSSpec(CurResFile, fs) = noErr then begin
  152.             if FSpOpenDF(fs, fsRdPerm, sd^.assimilator_datafork_rn) <> noErr then begin
  153.                 sd^.assimilator_datafork_rn := bad_rn;
  154.             end;
  155.         end;
  156.         
  157.         old_patch_addr := ProcPtr(NGetTrapAddress(_InitMenus, ToolTrap));
  158.         NSetTrapAddress(@MyPatch, _InitMenus, ToolTrap);
  159.  
  160.         a4 := RestoreA4(a4);
  161.     end;
  162.  
  163. end.
  164.